VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ODBC2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
'Project Name:  Array
'Host Name:     Array.ODBC2.Punchlist
'Date:          2009-06-01
'Version:
'Author:        Joseph Weir
'
' Array process for Punchlist.  To add other databases.

Option Explicit

 
'---------------------------------------------------------------------------------------
' Module    : ODBC2
' DateTime  : 6/3/2009
' Purpose   : Performs SQL operations:
'---------------------------------------------------------------------------------------
'
 
' Declare object(s)
Dim m_objConnection As FSIO.Connection
Public m_strRecipientCountry As String
'


'---------------------------------------------------------------------------------------
' Procedure : GetConnection
' DateTime  : 6/3/2009
' Purpose   : Create Import and/or Export connection
'---------------------------------------------------------------------------------------
'
Public Function GetConnection() As Boolean
 
    On Error GoTo GetConnection_Error
 
    If Not m_objConnection.IsOpen Then
        ' Show status window
        With StatusWindow
            .Alignment = fsiAlignCenter
            .BackColor = vbWhite
            .TopMost = fsiTopMost
            .Text = GetLiteral(202) ' Requires modLanguageSupport
            .Show
        End With
 
        Breathe
 
        ' Open connection
        With m_objConnection
            .Provider = "MSDASQL"
            If Windows.ComputerName = "CAN-00325000" Then
                .OpenCn "DSN=Shipnet2000;UID=dba;PWD=monky"
            Else
                .OpenCn DATA_SOURCE_NAME
            End If
        End With
    End If
 
    ' Set return value
    GetConnection = True
 
Release:
    ' Hide status window
    StatusWindow.Hide
    Exit Function
 
GetConnection_Error:
 
    MsgBox Err.Description, vbOKOnly + vbSystemModal, " (Array.ODBCPunchlist.GetConnection)"
 
    Resume Release
 
End Function
 
'---------------------------------------------------------------------------------------
' Procedure : InstantiateConnection
' DateTime  : 6/3/2009
' Purpose   : Create an instance of the connection object
'---------------------------------------------------------------------------------------
'
Private Function InstantiateConnection() As Boolean
 
    On Error GoTo InstantiateConnection_Error
 
    ' Instantiate connection
    If m_objConnection Is Nothing Then
        With ODBC2
            Set m_objConnection = .CreateConnection
        End With
    End If
 
    ' Set return value
    InstantiateConnection = True
 
    Exit Function
 
InstantiateConnection_Error:
 
    MsgBox Err.Description & " (Array.ODBCPunchlist.InstantiateConnection)", vbSystemModal
 
End Function
 
'---------------------------------------------------------------------------------------
' Procedure : DestroyConnection
' DateTime  : 6/3/2009
' Purpose   : Destroy the instance of the connection object
'---------------------------------------------------------------------------------------
'
Public Sub DestroyConnection()
 
    On Error GoTo DestroyConnection_Error
 
    ' Destroy connection
    Set m_objConnection = Nothing
 
    Exit Sub
 
DestroyConnection_Error:
 
    MsgBox Err.Description & " (Array.ODBCPunchlist.DestroyConnection)", vbSystemModal
 
End Sub


'---------------------------------------------------------------------------------------
' Procedure : RecordImport
' DateTime  : 6/3/2009
' Purpose   : Get import data
'---------------------------------------------------------------------------------------
'
Public Function OrderImport(ByVal strKeyValue As String, Optional strDateCreated As String) As FSIO.Recordset
 
    On Error GoTo RecordImport_Error
 
    ' Declare variables for procedure
    Dim objRecordset As FSIO.Recordset
    Dim strSQL As String
    Dim strCustomerID As String
    
    ' Validate Connection object
    If Not InstantiateConnection Then Exit Function
    ' Validate Connection state
    If Not GetConnection Then Exit Function
    
    ' Create the recordset object
    Set objRecordset = ODBC2.CreateRecordSet
    
    If Windows.ComputerName = "CAN-00325000" Then
        strSQL = "select * from Recipient where RecipientCode = '" & strKeyValue & "'"
    Else
        ' Set SQL statement
        strSQL = "Select "
        ' strSQL = strSQL & "OrderID, CustomerID, EmployeeID, OrderDate, PurchaseOrderNumber, ShipName,    ShipAddress, ShipCity,    ShipStateOrProvince, ShipPostalCode,  ShipCountry, ShipPhoneNumber, ShipDate,    ShippingMethodID,    Comments,    TrackingDate,    TrackingNumber, FreightCharge, CustomsDescription,  CompletedByProduction,   ChargeTo,    Shipped, ApprovedForProduction,  Weight, [BackOrderTracking#],  BackOrderShipDate"
        strSQL = strSQL & "OrderID, CustomerID, EmployeeID, OrderDate, PurchaseOrderNumber, ShipName,    ShipAddress, ShipCity,    ShipStateOrProvince, ShipPostalCode,  ShipCountry, ShipPhoneNumber, ShipDate,    ShippingMethodID,    Comments,    TrackingDate,    TrackingNumber, FreightCharge, CustomsDescription,  CompletedByProduction,   ChargeTo,    Shipped, ApprovedForProduction,  Weight "
        strSQL = strSQL & " From "
        strSQL = strSQL & Chr(34) & "Orders" & Chr(34)
        strSQL = strSQL & " Where "
        strSQL = strSQL & "OrderID" & " = " & strKeyValue
    End If
    
    ' Create recordset
    objRecordset.OpenRs strSQL, m_objConnection
    objRecordset.CloseRs
 
Release:
    Set OrderImport = objRecordset
    Set objRecordset = Nothing
 
 
    Exit Function
 
RecordImport_Error:
 
    MsgBox Err.Description & " (Array.ODBCPunchlist.RecordImport)", vbSystemModal
 
    Resume Release
 
End Function


'---------------------------------------------------------------------------------------
' Procedure : RecordImport
' DateTime  : 6/3/2009
' Purpose   : Get import data
'---------------------------------------------------------------------------------------
'
Public Function RecordImport(ByVal strKeyValue As String, Optional strDateCreated As String) As Collection
 
    On Error GoTo RecordImport_Error
 
    ' Declare variables for procedure
    Dim objRecordset As FSIO.Recordset
    Dim strSQL As String
    Dim strCustomerID As String
    
    Set RecordImport = New Collection
    m_strRecipientCountry = ""
        
    ' Validate Connection object
    If Not InstantiateConnection Then Exit Function
    ' Validate Connection state
    If Not GetConnection Then Exit Function
    
    ' Create the recordset object
    Set objRecordset = ODBC2.CreateRecordSet
    ' Set SQL statement
    If Windows.ComputerName = "CAN-00325000" Then
        strSQL = "select * from Recipient where RecipientCode = '" & strKeyValue & "'"
    Else
        strSQL = "Select "
        strSQL = strSQL & "OrderID, CustomerID, EmployeeID, OrderDate, PurchaseOrderNumber, ShipName,    ShipAddress, ShipCity,    ShipStateOrProvince, ShipPostalCode,  ShipCountry, ShipPhoneNumber, ShipDate,    ShippingMethodID,    Comments,    TrackingDate,    TrackingNumber, FreightCharge, CustomsDescription,  CompletedByProduction,   ChargeTo,    Shipped, ApprovedForProduction,  Weight "
        strSQL = strSQL & " From "
        strSQL = strSQL & Chr(34) & "Orders" & Chr(34)
        strSQL = strSQL & " Where "
        strSQL = strSQL & "OrderID" & " = " & strKeyValue
    End If
    ' Create recordset
    
    objRecordset.OpenRs strSQL, m_objConnection
    RecordImport.Add objRecordset, "Orders"
    objRecordset.CloseRs
  
    If objRecordset.RecordCount > 0 _
    And Windows.ComputerName <> "CAN-00325000" Then
        
        If Trim(objRecordset.Records(0).Fields("ShipPostalCode").Value & "") <> "" Then
            If IsNumeric(objRecordset.Records(0).Fields("ShipPostalCode").Value) Then
                m_strRecipientCountry = "US"
            Else
                m_strRecipientCountry = "CA"
            End If
        End If
        
        strCustomerID = objRecordset.Records(0).Fields("CustomerID").Value
        
        ' Create the recordset object
        Set objRecordset = ODBC2.CreateRecordSet
        ' Set SQL statement
        strSQL = "Select "
        strSQL = strSQL & "CustomerID,  StoreID, [Customer#],   [Store#],  BillingAddress,  PostalCode,  StateOrProvince, City,    PhoneNumber "
        strSQL = strSQL & " From "
        strSQL = strSQL & "Customers"
        strSQL = strSQL & " Where "
        strSQL = strSQL & "CustomerID" & " = " & strCustomerID
        ' Create recordset
        objRecordset.OpenRs strSQL, m_objConnection
        RecordImport.Add objRecordset, "Customer"
        objRecordset.CloseRs
        
        If m_strRecipientCountry = "" Then
            If Trim(objRecordset.Records(0).Fields("PostalCode").Value & "") <> "" Then
                If IsNumeric(objRecordset.Records(0).Fields("PostalCode").Value) Then
                    m_strRecipientCountry = "US"
                Else
                    m_strRecipientCountry = "CA"
                End If
            End If
        End If
        
        If m_strRecipientCountry = "" Then
            If frmEntryBox.comboOrderSource.Text = "CotyPunchlistCA" Then
                m_strRecipientCountry = "CA"
            Else
                m_strRecipientCountry = "US"
            End If
        End If
        
        ' Create the recordset object
        Set objRecordset = ODBC2.CreateRecordSet
        ' Set SQL statement
        strSQL = "Select "
        strSQL = strSQL & "OrderDetailID,  OrderID, ProductID, Quantity,    UnitPrice,   Discount,    Comments,    BackOrders,  Reason"
        strSQL = strSQL & " From "
        strSQL = strSQL & "[Order Details]"
        strSQL = strSQL & " Where "
        strSQL = strSQL & "OrderID" & " = " & strKeyValue
        ' Create recordset
        objRecordset.OpenRs strSQL, m_objConnection
        RecordImport.Add objRecordset, "OrderDetails"
        objRecordset.CloseRs
 
        ' Create the recordset object
        Set objRecordset = ODBC2.CreateRecordSet
        ' Set SQL statement
        strSQL = "Select "
        strSQL = strSQL & "BoxId, Length,  Width,   Height,  Description, Notes,   OrdersOrderID,   Weight,  UOM, Type "
        strSQL = strSQL & " From "
        strSQL = strSQL & "BoxInfoPerOrder"
        strSQL = strSQL & " Where "
        strSQL = strSQL & "OrdersOrderID" & " = " & strKeyValue & ""
        
      ' logfile strSQL
        
        
        ' Create recordset
        objRecordset.OpenRs strSQL, m_objConnection
        RecordImport.Add objRecordset, "BoxInfoPerOrder"
        objRecordset.CloseRs
        
    End If
 
Release:
    ' Set RecordImport = objRecordset
    Set objRecordset = Nothing
 
 
    Exit Function
 
RecordImport_Error:
 
    MsgBox Err.Description & " (Array.ODBCPunchlist.RecordImport)", vbSystemModal
 
    Resume Release
    If False Then
        Resume
    End If
End Function


'---------------------------------------------------------------------------------------
' Procedure : SetPackageValues
' DateTime  : 6/3/2009
' Purpose   : Set the FSM Package object with record values
'---------------------------------------------------------------------------------------
'
Public Sub SetPackageValues(ByVal objRecords As Collection, ByRef objPackage As FSM.Package, Optional ByVal strKeyValue As String, Optional ByVal intRecordCurrent As Integer)
 
    On Error GoTo SetPackageValues_Error
    Dim i As Long
    Dim objOrderHeader As FSIX.Records
    Dim objOrderDetails As FSIX.Records
    Dim objCustomer As FSIX.Records
    Dim objBoxes As FSIX.Records
    Dim objFCIL As FedExCanada.TD
    Dim objSender As Sender
    
    Set objOrderHeader = objRecords.Item("Orders").Records
    If objRecords.Count > 1 Then
        Set objOrderDetails = objRecords.Item("OrderDetails").Records
        Set objCustomer = objRecords.Item("Customer").Records
        Set objBoxes = objRecords.Item("BoxInfoPerOrder").Records
    End If
    
    With objPackage
        .Invoice = objOrderHeader(intRecordCurrent).Fields("OrderID").Value
        .PackageType = g_formEntryBox.comboPackaging.Value
        .PaymentType = g_formEntryBox.comboFreight.Value
        .Recipient.AccountNo = g_formEntryBox.textFreightAcct.Value
        .PurchaseOrder = objOrderHeader(intRecordCurrent).Fields("PurchaseOrderNumber").Value
        With .Recipient
            If Trim(objOrderHeader(intRecordCurrent).Fields("ShipAddress").Value) <> "" _
            And Trim(objOrderHeader(intRecordCurrent).Fields("ShipPostalCode").Value) <> "" Then
                .Address1 = objOrderHeader(intRecordCurrent).Fields("ShipAddress").Value
                ' .Address2 = "..."
                .City = objOrderHeader(intRecordCurrent).Fields("ShipCity").Value
                .Company = objOrderHeader(intRecordCurrent).Fields("ShipName").Value
                .Contact = "Coty Rimmell Counter"
                .Country = objOrderHeader(intRecordCurrent).Fields("ShipCountry").Value & ""
                If .Country = "" Then
                    If IsNumeric(objOrderHeader(intRecordCurrent).Fields("ShipPostalCode").Value) Then
                        .Country = "US"
                    Else
                        .Country = "CA"
                    End If
                End If
                .Phone = PhoneNumber(objOrderHeader(intRecordCurrent).Fields("ShipPhoneNumber").Value)
                .State = objOrderHeader(intRecordCurrent).Fields("ShipStateOrProvince").Value
                ' .TaxID = "123456789"
                .Zip = objOrderHeader(intRecordCurrent).Fields("ShipPostalCode").Value
            Else
                .Address1 = objCustomer(intRecordCurrent).Fields("BillingAddress").Value
                ' .Address2 = "..."
                .City = objCustomer(intRecordCurrent).Fields("City").Value
                .Company = objCustomer(intRecordCurrent).Fields("StoreID").Value
                .Contact = "Coty Rimmell Counter"
                If IsNumeric(objCustomer(intRecordCurrent).Fields("PostalCode").Value) Then
                    .Country = "US"
                Else
                    .Country = "CA"
                End If
                .Phone = PhoneNumber(objCustomer(intRecordCurrent).Fields("PhoneNumber").Value)
                .State = objCustomer(intRecordCurrent).Fields("StateOrProvince").Value
                ' .TaxID = "123456789"
                .Zip = objCustomer(intRecordCurrent).Fields("PostalCode").Value
            End If
            .LocationNo = objCustomer(intRecordCurrent).Fields("Store#").Value
        
            If .Country = "US" Then
                If Len(.Zip) <= 5 Then
                    .Zip = Right("00000" & Trim(.Zip), 5)
                Else
                    .Zip = Right("000000000" & Trim(.Zip), 9)
                End If
            Else
                .Zip = Replace(Trim(.Zip), " ", "")
            End If
    
            If g_formEntryBox.textRecipientPhone.Value <> "" Then
                .Phone = PhoneNumber(g_formEntryBox.textRecipientPhone.Value)
            End If
            If .Phone = "" Then
                .Phone = "9198955350"
            End If
        End With        '.Recipient
        .CustomerReference = objOrderHeader(intRecordCurrent).Fields("OrderID").Value
        .Reference = objOrderHeader(intRecordCurrent).Fields("OrderID").Value
        .ServiceType = g_formEntryBox.comboService.Value
        .WeightType = fsmLbs
 
        If Not objBoxes Is Nothing Then
            If objBoxes.Count > 0 Then
                .Weight = objBoxes(0).Fields("Weight").Value
                With .Dimensions
                    .Height = objBoxes(0).Fields("Height").Value
                    .Length = objBoxes(0).Fields("Length").Value
                    .Width = objBoxes(0).Fields("Width").Value
                End With        '.Dimensions
                If 0 <> InStr(1, LCase(objBoxes(0).Fields("Type").Value & ""), "env") Then
                    .Intl.PackageType = fsmFedEx_Intl_Envelope
                Else
                    .Intl.PackageType = fsmFedEx_Intl_Box
                End If
            Else
                .Weight = 1
            End If
        Else
            .Weight = 1
        End If
        If .Weight < 1 Then .Weight = 1
        
        If .Recipient.Country <> "CA" Then
            If .Recipient.Country = "US" _
            And g_formEntryBox.checkTD Then
                .Intl.IncludeTD = True
                Set objSender = New Sender
                objSender.Lookup ("TDRETURN")
                With .ReturnAddress
                    .Address1 = objSender.Address1
                    .Address2 = objSender.Address2
                    .City = objSender.City
                    .Code = objSender.Code
                    .Company = objSender.Company
                    .Contact = objSender.Contact
                    .Phone = objSender.Phone
                    .State = objSender.State
                    .Zip = objSender.Zip
                End With
                .Intl.DutyTaxPayType = fsmBill_Sender
            Else
                .Intl.IncludeCommercialInvoice = True
                .Intl.TermsOfSale = fsmFOB_FCA
                ' 2011-03-15, JFW, ETD
                With .Intl
                    .IncludeTD = False
                    .UploadTradeDocumentsFlag = True
                    .IncludeCommercialInvoice = True
                    .CommercialInvoice.Copies = 0
                    If .Commodities.Count <= 0 Then
                        With .CommercialInvoice
                            .InvoiceType = fsmCommercialInvoice
                            .Copies = 0
                            .InvoicePurpose = fsmSold
                        End With
                    ElseIf False Then
                        With .CommercialInvoice
                            .InvoiceType = fsmCommercialInvoice
                            .Copies = 1
                            .InvoicePurpose = fsmSold
                        End With
                    Else
                        With .CommercialInvoice
                            .InvoiceType = fsmMyOwnCommercialInvoice
                            .Copies = 0
                            .InvoicePurpose = fsmSold
                            .InvoicePath = Cafe4.CreatePackageCI(objPackage)
                        End With
                    End If
                End With
                If g_formEntryBox.comboFreight.Value = fsm_Collect Then
                    .Intl.DutyTaxPayType = fsmBill_Recipient
                Else
                    .Intl.DutyTaxPayType = g_formEntryBox.comboFreight.Value
                    .Recipient.AccountNo = g_formEntryBox.textFreightAcct.Value
                End If
            End If
            With .Intl
                With .Commodities.Add("1")
                    .CountryOfMfg = "CA"
                    .Description = g_formEntryBox.textCmdtyDescription.Value
                    .UnitOfMeasure = "EA"
                    .UnitQuantity = CDbl("1")
                    If Not objOrderDetails Is Nothing Then
                        If objOrderDetails.Count > 0 Then
                            For i = 0 To objOrderDetails.Count - 1
                                If objOrderDetails(i).Fields("ProductID").Value & "" <> 1649 Then
                                    .Description = .Description & IIf(.Description <> "", ", ", "") & objOrderDetails(i).Fields("ProductID").Value
                                    .UnitValue = .UnitValue + objOrderDetails(i).Fields("UnitPrice").Value
                                End If
                            Next
                        End If
                    End If
                    If IsNumeric(g_formEntryBox.textCmdtyValue.Value) Then
                        .UnitValue = Val(g_formEntryBox.textCmdtyValue.Value)
                    End If
                End With        '.Commodities.Add(.Commodities.Count)
            End With        '.Intl
        End If
        
    End With
 
    Exit Sub
 
SetPackageValues_Error:
 
    If Err.Number = 13 Then
        Resume Next
    Else
        MsgBox Err.Description & " (Array.ODBCPunchlist.SetPackageValues)", vbSystemModal
    End If
    If False Then
        Resume
    End If
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : SetPackageValues
' DateTime  : 6/3/2009
' Purpose   : Set the FSM Package object with record values
'---------------------------------------------------------------------------------------
'
Public Sub SetPackageValuesTest(ByVal objRecords As Collection, ByRef objPackage As FSM.Package, Optional ByVal strKeyValue As String, Optional ByVal intRecordCurrent As Integer)
 
    On Error GoTo SetPackageValues_Error
    Dim i As Long
    Dim objOrderHeader As FSIX.Records
    Dim objOrderDetails As FSIX.Records
    Dim objCustomer As FSIX.Records
    Dim objBoxes As FSIX.Records
    Dim objFCIL As FedExCanada.TD
    Dim objSender As Sender
    
    Set objOrderHeader = objRecords.Item("Orders").Records
    If objRecords.Count > 1 Then
        Set objOrderDetails = objRecords.Item("OrderDetails").Records
        Set objCustomer = objRecords.Item("Customer").Records
        Set objBoxes = objRecords.Item("BoxInfoPerOrder").Records
    End If
    
    With objPackage
        .Invoice = "TestInv " & Format(Now, "HHnnss")
        .PackageType = g_formEntryBox.comboPackaging.Value
        .PaymentType = g_formEntryBox.comboFreight.Value
        .Recipient.AccountNo = g_formEntryBox.textFreightAcct.Value
        .PurchaseOrder = "TestPO " & Format(Now, "HHnnss")
        With .Recipient
            If True Then
                .Address1 = objOrderHeader(intRecordCurrent).Fields("StreetAddress1").Value
                ' .Address2 = "..."
                .City = objOrderHeader(intRecordCurrent).Fields("CityName").Value
                .Company = objOrderHeader(intRecordCurrent).Fields("RecpCoName").Value
                .Contact = "Coty Rimmell Counter"
                .Country = objOrderHeader(intRecordCurrent).Fields("CountryCode").Value
                .Phone = PhoneNumber(objOrderHeader(intRecordCurrent).Fields("PhoneNumber").Value)
                .State = objOrderHeader(intRecordCurrent).Fields("ProvinceText").Value
                ' .TaxID = "123456789"
                .Zip = objOrderHeader(intRecordCurrent).Fields("PostalCode").Value
            End If
        
            If .Country = "US" Then
                If Len(.Zip) <= 5 Then
                    .Zip = Right("00000" & Trim(.Zip), 5)
                Else
                    .Zip = Right("000000000" & Trim(.Zip), 9)
                End If
            Else
                .Zip = Replace(Trim(.Zip), " ", "")
            End If
    
            If g_formEntryBox.textRecipientPhone.Value <> "" Then
                .Phone = PhoneNumber(g_formEntryBox.textRecipientPhone.Value)
            End If
            If .Phone = "" Then
                .Phone = "9198955350"
            End If
        End With        '.Recipient
        .CustomerReference = "TestRef " & Format(Now, "HHnnss")
        .Reference = "TestRef " & Format(Now, "HHnnss")
        .ServiceType = g_formEntryBox.comboService.Value
        .WeightType = fsmLbs
 
        If Not objBoxes Is Nothing Then
            If objBoxes.Count > 0 Then
                .Weight = objBoxes(0).Fields("Weight").Value
                With .Dimensions
                    .Height = objBoxes(0).Fields("Height").Value
                    .Length = objBoxes(0).Fields("Length").Value
                    .Width = objBoxes(0).Fields("Width").Value
                End With        '.Dimensions
                If 0 <> InStr(1, LCase(objBoxes(0).Fields("Type").Value & ""), "env") Then
                    .Intl.PackageType = fsmFedEx_Intl_Envelope
                Else
                    .Intl.PackageType = fsmFedEx_Intl_Box
                End If
            Else
                .Weight = 1
            End If
        Else
            .Weight = 1
        End If
        If .Weight < 1 Then .Weight = 1
        
        If .Recipient.Country <> "CA" Then
            If .Recipient.Country = "US" _
            And g_formEntryBox.checkTD Then
                .Intl.IncludeTD = True
                Set objSender = New Sender
                objSender.Lookup ("TDRETURN")
                With .ReturnAddress
                    .Address1 = objSender.Address1
                    .Address2 = objSender.Address2
                    .City = objSender.City
                    .Code = objSender.Code
                    .Company = objSender.Company
                    .Contact = objSender.Contact
                    .Phone = objSender.Phone
                    .State = objSender.State
                    .Zip = objSender.Zip
                End With
                .Intl.DutyTaxPayType = fsmBill_Sender
            Else
                .Intl.PackageType = fsmFedEx_Intl_Box
                .Intl.IncludeCommercialInvoice = True
                .Intl.TermsOfSale = fsmFOB_FCA
                ' 2011-03-15, JFW, ETD
                With .Intl
                    .IncludeTD = False
                    .UploadTradeDocumentsFlag = True
                    .IncludeCommercialInvoice = True
                    .CommercialInvoice.Copies = 0
                    If .Commodities.Count <= 0 Then
                        With .CommercialInvoice
                            .InvoiceType = fsmCommercialInvoice
                            .Copies = 0
                            .InvoicePurpose = fsmSold
                        End With
                    ElseIf False Then
                        With .CommercialInvoice
                            .InvoiceType = fsmCommercialInvoice
                            .Copies = 1
                            .InvoicePurpose = fsmSold
                        End With
                    Else
                        With .CommercialInvoice
                            .InvoiceType = fsmMyOwnCommercialInvoice
                            .Copies = 0
                            .InvoicePurpose = fsmSold
                            .InvoicePath = Cafe4.CreatePackageCI(objPackage)
                        End With
                    End If
                End With
                If g_formEntryBox.comboFreight.Value = fsm_Collect Then
                    .Intl.DutyTaxPayType = fsmBill_Recipient
                Else
                    .Intl.DutyTaxPayType = g_formEntryBox.comboFreight.Value
                    .Recipient.AccountNo = g_formEntryBox.textFreightAcct.Value
                End If
            End If
            With .Intl
                With .Commodities.Add("1")
                    .CountryOfMfg = "CA"
                    .Description = g_formEntryBox.textCmdtyDescription.Value
                    .UnitOfMeasure = "EA"
                    .UnitQuantity = CDbl("1")
                    If Not objOrderDetails Is Nothing Then
                        If objOrderDetails.Count > 0 Then
                            For i = 0 To objOrderDetails.Count - 1
                                If objOrderDetails(i).Fields("ProductID").Value & "" <> 1649 Then
                                    .Description = .Description & IIf(.Description <> "", ", ", "") & objOrderDetails(i).Fields("ProductID").Value
                                    .UnitValue = .UnitValue + objOrderDetails(i).Fields("UnitPrice").Value
                                End If
                            Next
                        End If
                    End If
                    If IsNumeric(g_formEntryBox.textCmdtyValue.Value) Then
                        .UnitValue = Val(g_formEntryBox.textCmdtyValue.Value)
                    End If
                End With        '.Commodities.Add(.Commodities.Count)
            End With        '.Intl
        End If
        
    End With
 
    Exit Sub
 
SetPackageValues_Error:
 
    If Err.Number = 13 Then
        Resume Next
    Else
        MsgBox Err.Description & " (Array.ODBCPunchlist.SetPackageValues)", vbSystemModal
    End If
    If False Then
        Resume
    End If
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : SetPackageValues
' DateTime  : 6/3/2009
' Purpose   : Set the FSM Package object with record values
'---------------------------------------------------------------------------------------
'
Public Sub SetShipmentValues(ByVal objRecords As Collection, ByRef objShipment As FSM.Shipment, Optional ByVal strKeyValue As String, Optional ByVal intRecordCurrent As Integer)
 
    On Error GoTo SetPackageValues_Error
    Dim i As Long
    Dim objOrderHeader As FSIX.Records
    Dim objOrderDetails As FSIX.Records
    Dim objCustomer As FSIX.Records
    Dim objBoxes As FSIX.Records
    Dim objFCIL As FedExCanada.TD
    Dim objSender As Sender
    
    Set objOrderHeader = objRecords.Item("Orders").Records
    If objRecords.Count > 1 Then
        Set objOrderDetails = objRecords.Item("OrderDetails").Records
        Set objCustomer = objRecords.Item("Customer").Records
        Set objBoxes = objRecords.Item("BoxInfoPerOrder").Records
    End If
    
    With objShipment.MPS
        .Recipient.AccountNo = g_formEntryBox.textFreightAcct.Value
        With .Recipient
            If Trim(objOrderHeader(intRecordCurrent).Fields("ShipAddress").Value) <> "" _
            And Trim(objOrderHeader(intRecordCurrent).Fields("ShipPostalCode").Value) <> "" Then
                .Address1 = objOrderHeader(intRecordCurrent).Fields("ShipAddress").Value
                ' .Address2 = "..."
                .City = objOrderHeader(intRecordCurrent).Fields("ShipCity").Value
                .Company = objOrderHeader(intRecordCurrent).Fields("ShipName").Value
                .Contact = "Coty Rimmell Counter"
                .Country = objOrderHeader(intRecordCurrent).Fields("ShipCountry").Value & ""
                If .Country = "" Then
                    If IsNumeric(objOrderHeader(intRecordCurrent).Fields("ShipPostalCode").Value) Then
                        .Country = "US"
                    Else
                        .Country = "CA"
                    End If
                End If
                .Phone = PhoneNumber(objOrderHeader(intRecordCurrent).Fields("ShipPhoneNumber").Value)
                .State = objOrderHeader(intRecordCurrent).Fields("ShipStateOrProvince").Value
                ' .TaxID = "123456789"
                .Zip = objOrderHeader(intRecordCurrent).Fields("ShipPostalCode").Value
            Else
                .Address1 = objCustomer(intRecordCurrent).Fields("BillingAddress").Value
                ' .Address2 = "..."
                .City = objCustomer(intRecordCurrent).Fields("City").Value
                .Company = objCustomer(intRecordCurrent).Fields("StoreID").Value
                .Contact = "Coty Rimmell Counter"
                If IsNumeric(objCustomer(intRecordCurrent).Fields("PostalCode").Value) Then
                    .Country = "US"
                Else
                    .Country = "CA"
                End If
                .Phone = PhoneNumber(objCustomer(intRecordCurrent).Fields("PhoneNumber").Value)
                .State = objCustomer(intRecordCurrent).Fields("StateOrProvince").Value
                ' .TaxID = "123456789"
                .Zip = objCustomer(intRecordCurrent).Fields("PostalCode").Value
            End If
            .LocationNo = objCustomer(intRecordCurrent).Fields("Store#").Value
                
            If .Country = "US" Then
                If Len(.Zip) <= 5 Then
                    .Zip = Right("00000" & Trim(.Zip), 5)
                Else
                    .Zip = Right("000000000" & Trim(.Zip), 9)
                End If
            Else
                .Zip = Replace(Trim(.Zip), " ", "")
            End If
    
            If g_formEntryBox.textRecipientPhone.Value <> "" Then
                .Phone = PhoneNumber(g_formEntryBox.textRecipientPhone.Value)
            End If
            If .Phone = "" Then
                .Phone = "9198955350"
            End If
            
        End With        '.Recipient
 
 
        .ServiceType = g_formEntryBox.comboService.Value
        .WeightType = fsmLbs
        .PaymentType = g_formEntryBox.comboFreight.Value
        .PackageType = g_formEntryBox.comboPackaging.Value
 
        If Not objBoxes Is Nothing Then
            If objBoxes.Count > 0 Then
                For i = 0 To objBoxes.Count - 1
                    With objShipment.MPS.Packages.Add(CStr(i + 1))
                        .CustomerReference = objOrderHeader(intRecordCurrent).Fields("OrderID").Value
                        .Reference = objOrderHeader(intRecordCurrent).Fields("OrderID").Value
                        .InvoiceNumber = objOrderHeader(intRecordCurrent).Fields("OrderID").Value
                        .PurchaseOrder = objOrderHeader(intRecordCurrent).Fields("PurchaseOrderNumber").Value
                        .Weight = objBoxes(i).Fields("Weight").Value
                        .Height = objBoxes(i).Fields("Height").Value
                        .Length = objBoxes(i).Fields("Length").Value
                        .Width = objBoxes(i).Fields("Width").Value
                        If .Weight < 1 Then .Weight = 1
                    End With
                    If 0 <> InStr(1, LCase(objBoxes(i).Fields("Type").Value & ""), "env") Then
                        .International.PackageType = fsmFedEx_Intl_Envelope
                    Else
                        .International.PackageType = fsmFedEx_Intl_Box
                    End If
                Next i
            Else
                Err.Raise 12345, "Error processing MPS shipment, no Boxes in datebase."
            End If
        Else
            Err.Raise 12345, "Error processing MPS shipment, no Boxes in datebase."
        End If
        
        If .Recipient.Country <> "CA" Then
            With .International
                .IncludeCommercialInvoice = True
                .TermsOfSale = fsmFOB_FCA
                ' 2011-03-15, JFW, ETD
                .IncludeTD = False
                .UploadTradeDocumentsFlag = True
                .IncludeCommercialInvoice = True
                .CommercialInvoice.Copies = 0
                If .Commodities.Count <= 0 Then
                    With .CommercialInvoice
                        .InvoiceType = fsmCommercialInvoice
                        .Copies = 0
                        .InvoicePurpose = fsmSold
                    End With
                Else
                    With .CommercialInvoice
                        .InvoiceType = fsmMyOwnCommercialInvoice
                        .Copies = 0
                        .InvoicePurpose = fsmSold
                        .InvoicePath = Cafe4.CreateShipmentCI(objShipment)
                    End With
                End If
                If g_formEntryBox.comboFreight.Value = fsm_Collect Then
                    .DutyTaxPayType = fsmBill_Recipient
                Else
                    .DutyTaxPayType = g_formEntryBox.comboFreight.Value
                    objShipment.Recipient.AccountNo = g_formEntryBox.textFreightAcct.Value
                End If
                objShipment.Recipient.AccountNo = g_formEntryBox.textFreightAcct.Value
                With .Commodities.Add("1")
                    .CountryOfMfg = "CA"
                    .Description = g_formEntryBox.textCmdtyDescription.Value
                    .UnitOfMeasure = "EA"
                    .UnitQuantity = CDbl("1")
                    If Not objOrderDetails Is Nothing Then
                        If objOrderDetails.Count > 0 Then
                            For i = 0 To objOrderDetails.Count - 1
                                If objOrderDetails(i).Fields("ProductID").Value & "" <> 1649 Then
                                    .Description = .Description & IIf(.Description <> "", ", ", "") & objOrderDetails(i).Fields("ProductID").Value
                                    .UnitValue = .UnitValue + objOrderDetails(i).Fields("UnitPrice").Value
                                End If
                            Next
                        End If
                    End If
                    If IsNumeric(g_formEntryBox.textCmdtyValue.Value) Then
                        .UnitValue = Val(g_formEntryBox.textCmdtyValue.Value)
                    End If
                End With        '.Commodities.Add(.Commodities.Count)
            End With        '.Intl
        End If
        
    End With
 
    Exit Sub
 
SetPackageValues_Error:
 
    If Err.Number = 13 Then
        Resume Next
    Else
        MsgBox Err.Description & " (Array.ODBCPunchlist.SetShipmentValues)", vbSystemModal
    End If
    If False Then
        Resume
    End If
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : SetPackageValues
' DateTime  : 6/3/2009
' Purpose   : Set the FSM Package object with record values
'---------------------------------------------------------------------------------------
'
Public Sub SetTDMPSValues(ByVal objRecords As Collection, ByRef colPackage As Collection, Optional ByVal strKeyValue As String, Optional ByVal intRecordCurrent As Integer)
 
    On Error GoTo SetPackageValues_Error
    Dim i As Long
    Dim objOrderHeader As FSIX.Records
    Dim objOrderDetails As FSIX.Records
    Dim objCustomer As FSIX.Records
    Dim objBoxes As FSIX.Records
    Dim objFCIL As FedExCanada.TD
    Dim objSender As Sender
    Dim intPackageCount As Long
    Dim objShipment As Shipment
    
    Set objOrderHeader = objRecords.Item("Orders").Records
    If objRecords.Count > 1 Then
        Set objOrderDetails = objRecords.Item("OrderDetails").Records
        Set objCustomer = objRecords.Item("Customer").Records
        Set objBoxes = objRecords.Item("BoxInfoPerOrder").Records
    End If
    
    For intPackageCount = 0 To objBoxes.Count - 1
    
       Set objShipment = New Shipment
       With objShipment.Package
           .Invoice = objOrderHeader(intRecordCurrent).Fields("OrderID").Value
           If objBoxes.Count > 1 Then
                .Invoice = .Invoice & ", pkg " & CStr(intPackageCount + 1) & " of " & objBoxes.Count
           End If
           .PackageType = g_formEntryBox.comboPackaging.Value
           .PaymentType = g_formEntryBox.comboFreight.Value
           .Recipient.AccountNo = g_formEntryBox.textFreightAcct.Value
           .PurchaseOrder = objOrderHeader(intRecordCurrent).Fields("PurchaseOrderNumber").Value
           With .Recipient
               If Trim(objOrderHeader(intRecordCurrent).Fields("ShipAddress").Value) <> "" _
               And Trim(objOrderHeader(intRecordCurrent).Fields("ShipPostalCode").Value) <> "" Then
                   .Address1 = objOrderHeader(intRecordCurrent).Fields("ShipAddress").Value
                   ' .Address2 = "..."
                   .City = objOrderHeader(intRecordCurrent).Fields("ShipCity").Value
                   .Company = objOrderHeader(intRecordCurrent).Fields("ShipName").Value
                   .Contact = "Coty Rimmell Counter"
                   .Country = objOrderHeader(intRecordCurrent).Fields("ShipCountry").Value
                    If .Country = "" Then
                        If IsNumeric(objOrderHeader(intRecordCurrent).Fields("ShipPostalCode").Value) Then
                            .Country = "US"
                        Else
                            .Country = "CA"
                        End If
                    End If
                   .Phone = PhoneNumber(objOrderHeader(intRecordCurrent).Fields("ShipPhoneNumber").Value)
                   .State = objOrderHeader(intRecordCurrent).Fields("ShipStateOrProvince").Value
                   ' .TaxID = "123456789"
                   .Zip = objOrderHeader(intRecordCurrent).Fields("ShipPostalCode").Value
               Else
                   .Address1 = objCustomer(intRecordCurrent).Fields("BillingAddress").Value
                   ' .Address2 = "..."
                   .City = objCustomer(intRecordCurrent).Fields("City").Value
                   .Company = objCustomer(intRecordCurrent).Fields("StoreID").Value
                   .Contact = "Coty Rimmell Counter"
                   If IsNumeric(objCustomer(intRecordCurrent).Fields("PostalCode").Value) Then
                       .Country = "US"
                   Else
                       .Country = "CA"
                   End If
                   .Phone = PhoneNumber(objCustomer(intRecordCurrent).Fields("PhoneNumber").Value)
                   .State = objCustomer(intRecordCurrent).Fields("StateOrProvince").Value
                   ' .TaxID = "123456789"
                   .Zip = objCustomer(intRecordCurrent).Fields("PostalCode").Value
               End If
                .LocationNo = objCustomer(intRecordCurrent).Fields("Store#").Value
           
               If .Country = "US" Then
                   If Len(.Zip) <= 5 Then
                       .Zip = Right("00000" & Trim(.Zip), 5)
                   Else
                       .Zip = Right("000000000" & Trim(.Zip), 9)
                   End If
               Else
                   .Zip = Replace(Trim(.Zip), " ", "")
               End If
       
               If g_formEntryBox.textRecipientPhone.Value <> "" Then
                   .Phone = PhoneNumber(g_formEntryBox.textRecipientPhone.Value)
               End If
               If .Phone = "" Then
                   .Phone = "9198955350"
               End If
               
           End With        '.Recipient
           .CustomerReference = objOrderHeader(intRecordCurrent).Fields("OrderID").Value
           .Reference = objOrderHeader(intRecordCurrent).Fields("OrderID").Value
           .ServiceType = g_formEntryBox.comboService.Value
           .WeightType = fsmLbs
    
           If Not objBoxes Is Nothing Then
               If intPackageCount < objBoxes.Count Then
                   .Weight = objBoxes(intPackageCount).Fields("Weight").Value
                   If .Weight < 1 Then .Weight = 1
                   With .Dimensions
                       .Height = objBoxes(intPackageCount).Fields("Height").Value
                       .Length = objBoxes(intPackageCount).Fields("Length").Value
                       .Width = objBoxes(intPackageCount).Fields("Width").Value
                   End With        '.Dimensions
                Else
                    Err.Raise 12345, "Error processing TD MPS shipment, no Boxes in datebase, package " & intPackageCount & "."
               End If
            Else
                Err.Raise 12345, "Error processing TD MPS shipment, no Boxes in datebase."
           End If
        
           If .Recipient.Country <> "CA" Then
               If .Recipient.Country = "US" _
               And g_formEntryBox.checkTD Then
                   .Intl.IncludeTD = True
                   Set objSender = New Sender
                   objSender.Lookup ("TDRETURN")
                   With .ReturnAddress
                       .Address1 = objSender.Address1
                       .Address2 = objSender.Address2
                       .City = objSender.City
                       .Code = objSender.Code
                       .Company = objSender.Company
                       .Contact = objSender.Contact
                       .Phone = objSender.Phone
                       .State = objSender.State
                       .Zip = objSender.Zip
                   End With
                    .Intl.DutyTaxPayType = fsmBill_Sender
                Else
                    If g_formEntryBox.comboFreight.Value = fsm_Collect Then
                        .Intl.DutyTaxPayType = fsmBill_Recipient
                    Else
                        .Intl.DutyTaxPayType = g_formEntryBox.comboFreight.Value
                        .Recipient.AccountNo = g_formEntryBox.textFreightAcct.Value
                    End If
               End If
               With .Intl
                    If intPackageCount = 0 Then
                        With .Commodities.Add("1")
                            .CountryOfMfg = "CA"
                            .Description = g_formEntryBox.textCmdtyDescription.Value
                            .UnitOfMeasure = "EA"
                            .UnitQuantity = CDbl("1")
                            If Not objOrderDetails Is Nothing Then
                                If objOrderDetails.Count > 0 Then
                                    For i = 0 To objOrderDetails.Count - 1
                                        If objOrderDetails(i).Fields("ProductID").Value & "" <> 1649 Then
                                            .Description = .Description & IIf(.Description <> "", ", ", "") & objOrderDetails(i).Fields("ProductID").Value
                                            .UnitValue = .UnitValue + objOrderDetails(i).Fields("UnitPrice").Value
                                        End If
                                    Next
                                End If
                            End If
                            If IsNumeric(g_formEntryBox.textCmdtyValue.Value) Then
                                .UnitValue = Val(g_formEntryBox.textCmdtyValue.Value)
                            End If
                        End With        '.Commodities.Add(.Commodities.Count)
                    Else
                        With .Commodities.Add("1")
                            .CountryOfMfg = "CA"
                            .Description = "Reference " & strKeyValue & ", package " & CStr(intPackageCount + 1) & " of " & objBoxes.Count
                            .UnitOfMeasure = "EA"
                            .UnitQuantity = CDbl("1")
                            .UnitValue = 0.000001
                        End With        '.Commodities.Add(.Commodities.Count)
                    End If
               End With        '.Intl
           End If
           
        End With
    
        colPackage.Add objShipment
    Next intPackageCount
    
    Exit Sub
 
SetPackageValues_Error:
 
    If Err.Number = 13 Then
        Resume Next
    Else
        MsgBox Err.Description & " (Array.ODBCPunchlist.SetTDMPSValues)", vbSystemModal
    End If
    If False Then
        Resume
    End If
End Sub




